REM MORSE CODE GENERATOR PROGRAM

CLEAR, 30000
RANDOMIZE TIMER
SCREEN 1,640,200,4,2
WINDOW 2,"MORSE-CODE",(0,0)-(631,186),0,1

PALETTE 0,0,0,0       'BLACK
PALETTE 1,0.93,0.2,0    'FIRE ENGINE RED
PALETTE 2,0.4,0.6,1     'DARK BLUE
PALETTE 3,0.73,0.73,0.73 'GRAY
PALETTE 4,1,1,0.13     'YELLOW
PALETTE 5,0.33,0.87,0   'GREEN
PALETTE 6,1,1,1       'WHITE
PALETTE 7,0.8,0.6,0.53   'BROWN
PALETTE 8,0.4,0.6,1
WIDTH 80
COLOR 0,2
CLS
WINDOW OUTPUT 2

Z=199
FOR Y=Z TO 1 STEP -2:X=320
LINE (X,Z)-(1,Y)
NEXT
Z=320
FOR X=0 TO 639 STEP 2
LINE (X,0)-(Z,199)
NEXT
Z=199
FOR Y=0 TO Z STEP 2:X=320
LINE (X,Z)-(640,Y)
NEXT

DIM N1(50),CW$(50),DUR(50,6)

FOR I=1 TO 45
READ N1(I),CW$(I)
FOR J=1 TO N1(I)
READ DUR(I,J)
NEXT J:NEXT I

LEFT=160:RIGHT=470
FOR X=100 TO 15 STEP -1
LINE (LEFT,X)-(RIGHT,X),0
LEFT=LEFT-2:RIGHT=RIGHT+2
NEXT
COLOR 1,0

P=800          'INITIAL PITCH VALUE
WPM=7          'INITIAL WORDS/MINUTE
DOT=(14.7/WPM) 'CALCULATE SPEED, DOT TIME
DASH=DOT*3     'DASH TIME
VOL=255        'INITIAL VOLUME

DEF FNRATIO (A,B,C) = (A-B)/(C-2)
DEF FNVALUE (A,B,C,D) = ((A-B+1)/C)+D-1

PBW=600  'PITCH BAR WIDTH
PBH=14   'PITCH BAR HEIGHT
PBSX=14  'PITCH BAR START X VALUE
PBSY=21  'PITCH BAR START Y VALUE
PSR=399  'PITCH START RANGE
PER=1200 'PITCH END RANGE
PBR=FNRATIO(PER,PSR,PBW)
PBI=FNVALUE(800,PSR,PBR,PBSX)

SBW=400  'SPEED BAR WIDTH
SBH=14   'SPEED BAR HEIGHT
SBSX=114 'SPEED BAR START X VALUE
SBSY=21  'SPEED BAR START Y VALUE
SSR=2    'SPEED START RANGE
SER=18   'SPEED END RANGE
SBR=FNRATIO(SER,SSR,SBW) 
SBI=FNVALUE(7,SSR,SBR,SBSX)    

VBW=600  'VOLUME BAR WIDTH
VBH=14   'VOLUME BAR HEIGHT
VBSX=14  'VOLUME BAR START X VALUE
VBSY=21  'VOLUME BAR START Y VALUE
VSR=1    'VOLUME START RANGE
VER=256  'VOLUME END RANGE
VBR=FNRATIO(VER,VSR,VBW) 
VBI=FNVALUE(255,VSR,VBR,VBSX)    

CALL CENTERSTRING(3,"M O R S E ")   
CALL CENTERSTRING(4,"C O D E")
CALL CENTERSTRING(5,"G E N E R A T O R") 
CALL CENTERSTRING(7,"SELECT FUNCTION FROM PULLDOWN MENU")
CALL CENTERSTRING(8,"USING RIGHT MOUSE BUTTON")
CALL CENTERSTRING(11,"YOU MAY ALSO SELECT WHICH CHARACTERS YOU WISH TO ")
CALL CENTERSTRING(12,"PRACTICE WITH FOR THE 'RANDOM RECEIVING PRACTICE' ")
CALL CENTERSTRING(13,"AND THE 'RECEIVING QUIZ' FUNCTIONS...")
CALL CENTERSTRING(15,"AND/OR ADJUST CONTROLS TO YOUR LIKING")

MENU 1,0,1,"FUNCTION"
MENU 1,1,1,"  RANDOM RECEIVING PRACTICE"
MENU 1,2,1,"  RECEIVING QUIZ           "
MENU 1,3,1,"  KEYBOARD SENDING         "
MENU 1,4,1,"  SOUND A TEXT FILE        "
MENU 1,5,1,"  QUIT                     "

MENU 2,0,1,"CHARACTER USAGE"
MENU 2,1,1,"  All ALPHA, NUM and SPECIAL"
MENU 2,2,1,"  All ALPHABETIC       "
MENU 2,3,1,"  All NUMERIC          "
MENU 2,4,1,"  NUM 1 THRU 5         "
MENU 2,5,1,"  NUM 6 THRU 0         "
MENU 2,6,1,"  All SPECIAL          "
MENU 2,7,1,"  A,E,I,M,N,T ONLY     "
MENU 2,8,1,"  D,G,K,O,R   ONLY     "
MENU 2,9,1,"  B,S,U,W     ONLY     "
MENU 2,10,1,"  C,F,H,J     ONLY     "
MENU 2,11,1,"  L,P,Q,V     ONLY     "
MENU 2,12,1,"  X,Y,Z       ONLY     "

MENU 3,0,1,"CONTROLS"
MENU 3,1,1,"  CHANGE PITCH (800HZ)      "
MENU 3,2,1,"  CHANGE SPEED (7 WORDS/MIN)"
MENU 3,3,1,"  CHANGE VOLUME (255)       "

MENU 4,0,1,"" 'TURN OFF BASIC MENU 4

MENU ON

FUNCT2=2:OLDFUNC2=2 'INDICATE DEFAULT CHARACTER USAGE
GOSUB CHAR

MLOOP:
ON MENU GOSUB START
FOR X=1 TO 5:AN$=INKEY$:NEXT X
B=MOUSE(0)
SLEEP
GOTO MLOOP

START:
SELMENU = MENU(0)
ON SELMENU GOSUB 100,200,300
OLDMENU = SELMENU
RETURN

100 :
CLS
FUNCT=MENU(1)
COLOR 3,0
CLS
ON FUNCT GOSUB RCV,TEST,KEYBD,FILEKEY,BYE
OLDFUNC=FUNCT
RETURN

200 :
COLOR 3,0
CLS
FUNCT2=MENU(1)
GOSUB CHAR
OLDFUNC2=FUNCT2
RETURN

300 :
COLOR 3,0
CLS
FUNCT3=MENU(1)
ON FUNCT3 GOSUB DOMOUSE,DOMOUSE,DOMOUSE
OLDFUNC3=FUNCT3
RETURN


DOMOUSE:
MENU OFF
CLS
B=MOUSE(0)
IF FUNCT3=1 THEN GOSUB PITCHBAR
IF FUNCT3=2 THEN GOSUB SPEEDBAR
IF FUNCT3=3 THEN GOSUB VOLBAR
CHKMOUSE:
GOSUB MOUSER
IF B=0 THEN GOTO CHKMOUSE
IF FUNCT3=1 THEN LOCATE ((PBSY+PBH-1)/7)+2,1:PRINT"PITCH RESET/CHANGED":BEEP
IF FUNCT3=2 THEN LOCATE ((SBSY+SBH-1)/7)+2,1:PRINT"SPEED RESET/CHANGED":BEEP
IF FUNCT3=3 THEN LOCATE ((VBSY+VBH-1)/7)+2,1:PRINT"VOLUME RESET/CHANGED":BEEP
B=MOUSE(0)
MENU ON
RETURN

MOUSER:
B=MOUSE(0):X=MOUSE(1):Y=MOUSE(2)
IF FUNCT3=1 AND B<>0 AND X>PBSX AND X<PBSX+PBW AND Y>PBSY AND Y<PBSY+PBH THEN GOSUB PITCHCTRL
IF FUNCT3=2 AND B<>0 AND X>SBSX AND X<SBSX+SBW AND Y>SBSY AND Y<SBSY+SBH THEN GOSUB SPEEDCTRL
IF FUNCT3=3 AND B<>0 AND X>VBSX AND X<VBSX+VBW AND Y>VBSY AND Y<VBSY+VBH THEN GOSUB VOLCTRL
RETURN

PITCHBAR:
LINE(PBSX,PBSY)-(PBSX+PBW-1,PBSY+PBH-1),1,B
LOCATE ((PBSY+PBH-1)/7)+1,1
PRINT "PITCH BAR"
B=1:X=PBI:Y=PBSY+PBH-2:GOSUB PITCHCTRL
RETURN

SPEEDBAR:
LINE(SBSX,SBSY)-(SBSX+SBW-1,SBSY+SBH-1),1,B
LOCATE ((SBSY+SBH-1)/7)+1,1
PRINT "SPEED BAR"
B=1:X=SBI:Y=SBSY+SBH-2:GOSUB SPEEDCTRL
RETURN

VOLBAR:
LINE(VBSX,VBSY)-(VBSX+VBW-1,VBSY+VBH-1),1,B
LOCATE ((VBSY+VBH-1)/7)+1,1
PRINT "VOLUME BAR"
B=1:X=VBI:Y=VBSY+VBH-2:GOSUB VOLCTRL
RETURN

PITCHCTRL:
WHILE B<>0 AND X>PBSX AND X<PBSX+PBW-1 AND Y>PBSY AND Y<PBSY+PBH-1
  LINE (PBSX+1,PBSY+1)-(PBSX+PBW-2,PBSY+PBH-2),0,BF
  LINE (PBSX+1,PBSY+1)-(X,PBSY+PBH-2),3,BF
  P=(X-PBSX+1)*PBR+PSR-1
  LOCATE ((PBSY+PBH-1)/7)+1,11
  PRINT USING">####HZ";P
  PBI=X
  B=MOUSE(0):X=MOUSE(1):Y=MOUSE(2)
WEND
RETURN

SPEEDCTRL:
WHILE B<>0 AND X>SBSX AND X<SBSX+SBW-1 AND Y>SBSY AND Y<SBSY+SBH-1
  LINE (SBSX+1,SBSY+1)-(SBSX+SBW-2,SBSY+SBH-2),0,BF
  LINE (SBSX+1,SBSY+1)-(X,SBSY+SBH-2),3,BF
  WPM=(X-SBSX+1)*SBR+SSR-1
  LOCATE ((SBSY+SBH-1)/7)+1,11
  PRINT USING">## WORDS/MIN";WPM
  SBI=X
  B=MOUSE(0):X=MOUSE(1):Y=MOUSE(2)
WEND
DOT=(14.7/WPM) 'CALCULATE SPEED, DOT TIME
DASH=DOT*3
RETURN

VOLCTRL:
WHILE B<>0 AND X>VBSX AND X<VBSX+VBW-1 AND Y>VBSY AND Y<VBSY+VBH-1
  LINE (VBSX+1,VBSY+1)-(VBSX+VBW-2,VBSY+VBH-2),0,BF
  LINE (VBSX+1,VBSY+1)-(X,VBSY+VBH-2),3,BF
  VOL=(X-VBSX+1)*VBR+VSR-1
  LOCATE ((VBSY+VBH-1)/7)+1,12
  PRINT USING">### VOLUME LEVEL";VOL
  VBI=X
  B=MOUSE(0):X=MOUSE(1):Y=MOUSE(2)
WEND
RETURN

CHAR:
MENU 2,OLDFUNC2,1
MENU 2,FUNCT2,2
MENU OFF
IF FUNCT2=1 THEN SW=1:SX=44:NR=44
IF FUNCT2=2 THEN SW=1:SX=26:NR=26
IF FUNCT2=3 THEN SW=27:SX=36:NR=10
IF FUNCT2=4 THEN SW=27:SX=31:NR=5
IF FUNCT2=5 THEN SW=32:SX=36:NR=5
IF FUNCT2=6 THEN SW=37:SX=44:NR=8
IF FUNCT2=7 THEN SW=1:SX=6:NR=6
IF FUNCT2=8 THEN SW=7:SX=11:NR=5
IF FUNCT2=9 THEN SW=12:SX=15:NR=4
IF FUNCT2=10 THEN SW=16:SX=19:NR=4
IF FUNCT2=11 THEN SW=20:SX=23:NR=4
IF FUNCT2=12 THEN SW=24:SX=26:NR=3
IF SELMENU = 2 THEN
  PRINT:PRINT "CHARACTER SELECTION COMPLETED. SELECT NEW FUNCTION."
END IF
BEEP
MENU ON
RETURN

KEYBD:
MENU 1,OLDFUNC,1
MENU 1,3,2
MENU OFF
PRINT :PRINT "START TYPING. CLICK LEFT MOUSE BUTTON TO END."
GETAKEY:
C$=INKEY$
B=MOUSE(0)
IF B=1 THEN BEEP:GOTO EXKEYBD  
IF C$="" THEN GOTO GETAKEY
C$=UCASE$(C$)
SOUND P,DASH,0 'WAIT ONE DOT LENGHT.
C=ASC(C$)
IF C=27 THEN GOTO EXKEYBD
FOR I=1 TO 45
  IF CW$(I) = C$ THEN 
    C=I
    I=45
  ELSE
    C=45
  END IF
NEXT I
GOSUB SOUNDIT
PRINT CW$(C);
GOTO GETAKEY
EXKEYBD:
CLS
PRINT:PRINT"FUNCTION ENDED. SELECT NEW FUNCTION"
MENU ON
RETURN

RCV:
MENU 1,OLDFUNC,1
MENU 1,1,2
MENU OFF
PRINT:PRINT"CLICK LEFT MOUSE BUTTON TO END."
I=0
ENDX=14/WPM*1400
RAND:
C=(INT(RND*NR))+SW
GOSUB SOUNDIT
I=I+1:PRINT "- ";CW$(C);" - ";
FOR X=1 TO ENDX:NEXT X
IF I=5 THEN PRINT" ":I=0
SOUND P,DASH,0 'WAIT ONE DOT LENGHT.
IF I=0 THEN SOUND P,(DASH*2.4),0
IF I<>0 THEN GOTO RCV2
FOR X=1 TO ENDX:NEXT X
RCV2:
B=MOUSE(0)
IF B=1 THEN BEEP:GOTO EXRCV 
AN$=INKEY$
IF AN$="" THEN GOTO RAND 
AN=ASC(AN$)
IF AN=27 THEN GOTO EXRCV 
GOTO RAND
EXRCV:
CLS
PRINT:PRINT"FUNCTION ENDED. SELECT NEW FUNCTION"
MENU ON
RETURN

TEST:
THREE=1
POSITION=1
TOTAL=0
WRONG=0
MENU 1,OLDFUNC,1
MENU 1,2,2 
MENU OFF
PRINT :PRINT "YOU GET THREE TRIES TO GUESS CORRECTLY!"
PRINT :PRINT "CLICK LEFT MOUSE BUTTON TO END."
PICKIT:
C=(INT(RND*NR))+SW
SEND:
GOSUB SCOREIT
TOTAL=TOTAL+1
GOSUB SOUNDIT
LOCATE 15,1
PRINT USING "ATTEMPT - # - ";THREE
ANSWER:
AN$=UCASE$(INKEY$)
B=MOUSE(0)
IF B=1 THEN BEEP:GOTO EXTEST 
IF AN$="" THEN GOTO ANSWER
AN=ASC(AN$)
IF AN=27 THEN GOTO EXTEST
LOCATE 12,POSITION:PRINT AN$;
IF POSITION=77 THEN 
  LOCATE 12,1
  PRINT"                                                                             "
  POSITION=1
END IF 
IF AN$<>CW$(C) THEN
  WRONG=WRONG+1
  LOCATE 17,1
  PRINT"                     ";
  THREE=THREE+1
  IF THREE<4 THEN  GOTO SEND
END IF
THREE=1
IF AN$=CW$(C) THEN 
  POSITION=POSITION+1
  LOCATE 17,1
  PRINT"LAST ONE WAS CORRECT";
END IF
GOTO PICKIT
EXTEST:
CLS
PRINT:PRINT"FUNCTION ENDED. SELECT NEW FUNCTION"
MENU ON
RETURN

SCOREIT:
IF TOTAL<>0 THEN
  LOCATE 23,1:PRINT"SCORE = ";
  PRINT USING "###.##";((100*((TOTAL-WRONG)/TOTAL)));
  PRINT USING "     TOTAL TRIES = ###";TOTAL;
END IF
RETURN

SOUNDIT:
FOR J=1 TO N1(C)
IF DUR(C,J) = 1 THEN SOUND P,DOT,VOL
IF DUR(C,J) = 3 THEN SOUND P,DASH,VOL
IF DUR(C,J) = 0 THEN SOUND P,DASH,0
SOUND P,DOT,0
NEXT J
RETURN

FILEKEY:
MENU 1,OLDFUNC,1
MENU 1,4,2
MENU OFF
PRINT :PRINT "SOUND TEXT FILE. CLICK LEFT MOUSE BUTTON AND/OR PRESS RETURN TO END."
PRINT
ON ERROR GOTO NTFND
GOTO ASKFILE
NTFND:
RESUME ERRED
ERRED:
WINDOW 3,,(70,50)-(560,150),0,1
WINDOW OUTPUT 3
LOCATE 7,19
PRINT "FILE ERROR - TRY AGAIN"
PRINT
LOCATE 9,22
PRINT "PRESS ANY KEY..."
CHKKEY:
IF INKEY$<>"" THEN GOTO WINCLO
GOTO CHKKEY
WINCLO:
WINDOW 2
WINDOW CLOSE 3
ASKFILE:
INPUT "ENTER 'DRIVE:FILE NAME' ";INFYLE$
B=MOUSE(0)
IF B=1 THEN GOTO EXFILEKEY
IF INFYLE$ = "" THEN GOTO EXFILEKEY
OPEN INFYLE$ FOR INPUT AS #1
INPUT "DISPLAY ALSO (Y OR N) ";E$
ENDY=14/WPM*1400
WHILE NOT EOF(1)
LINE INPUT #1,A$
D$=A$
FOR X=1 TO LEN(A$)
B=MOUSE(0)
IF B=1 THEN GOTO EXFILEKEY  
B$=INKEY$
C$=LEFT$(D$,1)
C$=UCASE$(C$)
SOUND P,DASH,0 'WAIT ONE DOT LENGHT.
D$=MID$(D$,2)
IF B$<>"" THEN B=ASC(B$)
IF B=27 THEN GOTO EXFILEKEY
FOR I=1 TO 45
  IF CW$(I) = C$ THEN 
    C=I
    I=45
  ELSE
    C=45
  END IF
NEXT I
GOSUB SOUNDIT
IF UCASE$(E$)="Y" THEN PRINT CW$(C);
FOR Y=1 TO ENDY:NEXT Y
NEXT X
IF UCASE$(E$)="Y" THEN PRINT " "
WEND
EXFILEKEY:
FOR X=1 TO 3000:NEXT X
CLS
CLOSE #1
PRINT:PRINT"FUNCTION ENDED. SELECT NEW FUNCTION"
BEEP
MENU ON
RETURN

BYE:
WINDOW 3,,(70,50)-(560,150),0,1
WINDOW OUTPUT 3
LOCATE 7,19
INPUT"EXIT BASIC (Y/N)";FIN$
IF UCASE$(FIN$) = "Y" THEN GOTO ENDBYE
WINDOW 2
WINDOW CLOSE 3
X=0:Y=186
SQUEEZE:
LINE (0,X+1)-(631,Y-1),1,B
LINE (0,X)-(631,Y),3,B
X=X+1:Y=Y-1
IF X=Y THEN LINE (X,50)-(Y,50),3 :ELSE GOTO SQUEEZE
ENDBYE:
WINDOW 1
BEEP
WINDOW CLOSE 2
SCREEN CLOSE 1
MENU RESET
IF UCASE$(FIN$)<>"Y" THEN END
WINDOW CLOSE 3
SYSTEM

SUB CENTERSTRING(ROW%,LIT$) STATIC
  LOCATE ROW%,40-(LEN(LIT$)/2)
  PRINT LIT$;
END SUB

DATA 1,E,1,2,I,1,1,1,T,3,2,M,3,3,2,A,1,3,2,N,3,1
DATA 3,D,3,1,1,3,G,3,3,1,3,K,3,1,3,3,O,3,3,3,3,R,1,3,1
DATA 3,S,1,1,1,3,U,1,1,3,3,W,1,3,3,4,B,3,1,1,1
DATA 4,C,3,1,3,1,4,F,1,1,3,1,4,H,1,1,1,1,4,J,1,3,3,3
DATA 4,L,1,3,1,1,4,P,1,3,3,1,4,Q,3,3,1,3,4,V,1,1,1,3
DATA 4,X,3,1,1,3,4,Y,3,1,3,3,4,Z,3,3,1,1,5,1,1,3,3,3,3
DATA 5,2,1,1,3,3,3,5,3,1,1,1,3,3,5,4,1,1,1,1,3
DATA 5,5,1,1,1,1,1,5,6,3,1,1,1,1,5,7,3,3,1,1,1
DATA 5,8,3,3,3,1,1,5,9,3,3,3,3,1,5,0,3,3,3,3,3
DATA 6,".",1,3,1,3,1,3,6,",",3,3,1,1,3,3
DATA 6,"?",1,1,3,3,1,1,5,"/",3,1,1,3,1
DATA 6,"<",1,1,1,1,1,1,5,"-",3,1,1,1,3
DATA 6,":",3,3,3,1,1,1,6,";",3,1,3,1,3,1,1," ",0
END